home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / microcrn / issue_32.arc / PASCAL.FIG < prev    next >
Text File  |  1979-12-31  |  4KB  |  113 lines
  1.  
  2. ((Pascal Fig. 1 - Search & Display Program for MS-DOS))
  3.  
  4. Program get_directory;  { MS-DOS version 2 or above }
  5.  
  6. const
  7.   get_dta = $2f00;      { get DTA address fxn }
  8.   srch_first = $4e00;   { search first matching file }
  9.   srch_next = $4f00;    { search next matching file }
  10.   srch_attr = $0000;    { don't use file attributes in search }
  11.  
  12. type
  13.  
  14.   regset = record       { image of processor registers }
  15.     ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  16.   end;
  17.  
  18.   dtatype = record      { image of Disk Transfer Area }
  19.     null : array [0..20] of byte;  { used by DOS }
  20.     attr : byte;        { file attribute spec }
  21.     time : integer;     { coded time of day }
  22.     date : integer;     { coded date }
  23.     fsiz : array [0..1] of integer; { file size in bytes }
  24.     fname : array[0..12] of char;  { filename, punctuated }
  25.   end;
  26.  
  27.   dtaptr = ^dtatype;
  28.  
  29. var
  30.   regs : regset;
  31.   curnt_dta : dtaptr;
  32.   searchname : string[64];      { room for a complete path }
  33.   i : integer;
  34.  
  35. begin
  36.   regs.ax := get_dta;   { request code to proper place }
  37.   msdos(regs);          { get and assign DTA address }
  38.   curnt_dta := ptr(regs.es,regs.bx);
  39.   searchname := 'DATA4*.JNK'+^@;        { what files are we searching? }
  40.   regs.cx := srch_attr; { search attributes }
  41.   regs.ax := srch_first;{ request code }
  42.   regs.ds := seg(searchname[1]);   { let DOS know where the string is }
  43.   regs.dx := ofs(searchname[1]);
  44.   msdos(regs);          { find first occurence }
  45.   if regs.ax = 18 then  { unsuccessful? }
  46.     writeln('No matching files')  { what went wrong? }
  47.   else
  48.     while regs.ax <> 18 do   { while we're successful }
  49.     begin
  50.       writeln;               { for demo, just ship to screen }
  51.       i := 0;                { character array pointer }
  52.       while (curnt_dta^.fname[i] <> ^@) and (i <= 12) do
  53.       begin
  54.         write(curnt_dta^.fname[i]);
  55.         i := succ(i);
  56.       end;
  57.       regs.ax := srch_next;  { repeat the search }
  58.       msdos(regs);
  59.     end;
  60. end.
  61.  
  62.  
  63. =-=--=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  64.  
  65. ((Pascal Fig. 2 -- Search & Display Program for CP/M))
  66.  
  67. Program get_cpm_dir;    ( CP/M version 2.2 }
  68.  
  69. const
  70.   set_dma = $1a;        { won't use default DMA buffer for CP/M }
  71.   srch_first = $11;     { request codes as above }
  72.   srch_next = $12;
  73.  
  74. type
  75.   fcb = record          { image of what CP/M expects }
  76.     drive : byte;       { drive spec }
  77.     fname : array[0..10] of char;  { filename }
  78.     extent : byte;      { extent (16K block) number }
  79.     s1,s2 : byte;       
  80.     rc : byte;          { record count for file }
  81.     map : array [0..15] of byte;  { disk allocation blocks used }
  82.     curr_rec : byte;    { current record for read/write }
  83.     rndm_rec : array[0..2] of byte;   { random I/O record }
  84.   end;
  85.  
  86. var
  87.   result, i : integer;
  88.   dma : array[0..127] of byte;   
  89.   our_fcb : fcb;
  90.  
  91. begin
  92.   bdos(set_dma,addr(dma));   { make CP/M put it where we want }
  93.   our_fcb.drive := 0;        { default drive }
  94.   our_fcb.fname := 'DATA4???JNK';   { this is what we want }
  95.   our_fcb.s2 := 0;
  96.   our_fcb.extent := 0;
  97.   result := bdos(srch_first,addr(our_fcb));   { is anybody home? }
  98.   if result <> 255 then       { gotcha? }
  99.     while result <> 255 do    { yeah, loop til not gotcha }
  100.     begin
  101.       result := result shl 5; { result * 32 = filename address offset in DMA }
  102.         writeln;
  103.         for i := result + 1 to result + 11 do { 8 char name, 3 char extension }
  104.         begin
  105.           write(chr(dma[i]));
  106.           if i - result = 8 then write('.'); { proper punctuation }
  107.         end;
  108.       result := bdos(srch_next);
  109.     end
  110.   else writeln('No matching files found.');  { sorry about that }
  111. end.
  112.  
  113.